{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveDataTypeable,
    FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, NamedFieldPuns
    #-}

module State.TuuraQueries(ReadTuuraDb(..),AddProblem(..),AddSubmission(..), NoSuchProblem(..)) where

import Happstack.State (Component(..), Dependencies, End, Query, Update, mkMethods, getEventClockTime)
import Control.Monad.Reader (ask)
import State.Database
import qualified Data.Map as Map
import Data.Map(Map)
import State.IdUtils
import Control.Monad.Trans.State.Lazy (State)
import Happstack.Data (Version, deriveSerialize)
import Data.Typeable (Typeable)
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.State.Lazy (gets, runState)
import Data.Maybe (isJust)

-- | Reads the whole Tuura db.
readTuuraDb :: Query TuuraDb TuuraDb
readTuuraDb = ask

-- modifyProblems func db@TuuraDb{problems} = db{problems = func problems}
-- modifySubmissions func db@TuuraDb{submissions} = db{submissions = func submissions}

-- | Promote a computation modifying a problem list into one operating on the TuuraDb
modifyProblemsM :: MonadState TuuraDb m => State (Map ProblemId ProblemInfo) a -> m a
modifyProblemsM = modifyRecordField problems (\s db -> db{problems = s})

type Modifier a = a -> a

-- | given a field getter and setter, promotes a stateful
-- computation on a field value into a comptation on a whole structure.
-- Also, promotes the enclosing monad from State to any other having instance of MonadState
modifyRecordField :: MonadState s m => (s -> fs) -> (fs -> Modifier s) -> State fs a -> m a
modifyRecordField getter setter func = do
    state0 <- get
    let (a, newState) = runState func (getter state0)
    put (setter newState state0)
    return a

modifySubmissions = modifyRecordField submissions (\s db -> db{submissions = s})

newtype NoSuchProblem = NoSuchProblem ProblemId deriving Typeable
$(deriveSerialize(''NoSuchProblem))
instance Version NoSuchProblem

-- | Adds a problem into the TuuraDb
addProblem :: ProblemInfo -> Update TuuraDb ProblemId
addProblem problem = modifyProblemsM $ insertAtNextIdM problem

-- | Adds the given submission into the DB
addSubmission :: (ProblemId, Program) -> Update TuuraDb (Either NoSuchProblem SubmissionId)
addSubmission (problemId, program) = do
    time <- getEventClockTime
    problemExists <- gets (isJust.(Map.lookup problemId).problems)
    if problemExists then do
        nextId <- modifySubmissions $ insertAtNextIdM $ SubmissionInfo program problemId time
        return (Right nextId)
      else
        return (Left $ NoSuchProblem problemId)

-- | Makes TuuraDb its own Component
instance Component TuuraDb where
  type Dependencies TuuraDb = End
  initialValue = TuuraDb {submissions = Map.empty, problems = Map.empty}

$(mkMethods ''TuuraDb ['readTuuraDb, 'addProblem, 'addSubmission])
